home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / SOLUTRI.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  5.7 KB  |  186 lines
  1. 10  'SOLUTRI - Solution of Triangles - 24 DEC 93 rev. 28 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF:SCREEN 0
  4. 40  COLOR 7,0,5
  5. 50  ON ERROR GOTO 170
  6. 60  UL$=STRING$(80,205)
  7. 70  '
  8. 80  '.....start
  9. 90  CLS
  10. 100  A=0:B=0:C=0:D=0:E=0:F=0:G=0:H=0:I=0:J=0:K=0:T1=0:T2=0
  11. 110  COLOR 15,1
  12. 120  PRINT " SOLUTION OF TRIANGLES";TAB(61);"by George C. Murphy ";
  13. 130  COLOR 5,0:PRINT STRING$(80,223);
  14. 140  COLOR 7,0
  15. 150  GOTO 290
  16. 160  '
  17. 170  IF ERR=5 OR ERR=11 THEN 190
  18. 180  BEEP:LOCATE 20:PRINT "Error";ERR;"in line";ERL:END
  19. 190  COLOR 14,0
  20. 200  BEEP:LOCATE 20:PRINT " THE COMBINATION OF FACTORS ENTERED IS EITHER ";
  21. 210  PRINT "IMPOSSIBLE OR UNSOLVABLE.":GOTO 240
  22. 220  COLOR 14,0:BEEP:LOCATE 20:PRINT " ANGLE MUST BE LESS THAN 90<UNK! {00F8}> ":GOTO 240
  23. 230  COLOR 14,0:BEEP:LOCATE 20:PRINT " ANGLE MUST BE LESS THAN 180 <UNK! {00F8}>":GOTO 240
  24. 240  PRINT:COLOR 7,0
  25. 250  PRINT " Press any key to start over...."
  26. 260  IF INKEY$=""THEN 260
  27. 270  GOTO 10
  28. 280  '
  29. 290  '.....start
  30. 300  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  31. 310  PI=3.14159
  32. 320  U$="####.###"
  33. 330  V$="####.##"
  34. 340  GOTO 410
  35. 350  '
  36. 360  '.....inverse sin and cos
  37. 370  ASN=ATN(X/SQR(-X*X+1))         'arc sin
  38. 380  ACS=-ASN+PI/2                  'arc cos
  39. 390  RETURN
  40. 400  '
  41. 410  '.....draw diagram
  42. 420  T=9
  43. 430  COLOR 7,0
  44. 440  PRINT TAB(T);"     |\                                     /^\"
  45. 450  PRINT TAB(T);"     |  \                                 / (f) \"
  46. 460  PRINT TAB(T);"     |(a) \                             /         \"
  47. 470  PRINT TAB(T);"     |      \                      <i>/             \<j>"
  48. 480  PRINT TAB(T);"     |        \<e>                  /                 \"
  49. 490  PRINT TAB(T);"     |          \                 /                     \"
  50. 500  PRINT TAB(T);"  <d>|        (b) \             / (h)                 (g) \"
  51. 510  PRINT TAB(T);"     |_ _ _ _ _ _ _ \         /_ _ _ _ _ _ _ _ _ _ _ _ _ _ _\"
  52. 520  PRINT TAB(T);"           <c>                              <k>"
  53. 530  COLOR 7,0
  54. 540  PRINT
  55. 550  PRINT TAB(T);"  RIGHT-ANGLED TRIANGLE           OBLIQUE-ANGLED TRIANGLE"
  56. 560  PRINT TAB(T);"  SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND           SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND"
  57. 570  PRINT TAB(T);"(a),(b) are the angles          (f),(g),(h) are the angles"
  58. 580  PRINT TAB(T);"<c>,<d>,<e> are the sides       <i>,<j>,<k> are the sides"
  59. 590  PRINT UL$;
  60. 600  '
  61. 610  '.....input data
  62. 620  X=97:Y=107
  63. 630  '
  64. 640  LOCATE 18,20:COLOR 0,7
  65. 650  PRINT " Press 1 to RUN program or 0 to EXIT.....":COLOR 7,0
  66. 660  Z$=INKEY$:IF Z$=""THEN 640
  67. 670  IF Z$="0"THEN RUN EX$
  68. 680  IF Z$="1"THEN 710
  69. 690  GOTO 640
  70. 700  '
  71. 710  LOCATE 18,2:COLOR 0,7
  72. 720  PRINT " Press one of the above letters to select a known angle or side..."
  73. 730  COLOR 7,0
  74. 740  Z$=INKEY$:IF Z$=""THEN 740
  75. 750  IF ASC(Z$)<X OR ASC(Z$)>Y THEN 740
  76. 760  IF ASC(Z$)<=101 THEN Y=101
  77. 770  IF Y=101 THEN FOR Z=3 TO 16:LOCATE Z,39:PRINT STRING$(40,32):NEXT Z
  78. 780  IF ASC(Z$)>=102 THEN X=102
  79. 790  IF X=102 THEN FOR Z=3 TO 16:LOCATE Z,1:PRINT STRING$(33,32):NEXT Z
  80. 800  '
  81. 810  LOCATE 18:PRINT STRING$(80,32);:LOCATE 18     'clear dialog line
  82. 820  Q=ASC(Z$)
  83. 830  IF(Q>=97 AND Q<=98)OR(Q>=102 AND Q<=104)THEN I$="Degrees, angle ("+Z$+")"
  84. 840  IF(Q>=99 AND Q<=101)OR(Q>=105 AND Q<=107)THEN I$="Length of side <"+Z$+">"
  85. 850  PRINT " ENTER: ";I$;
  86. 860  '
  87. 870  '.....right-angled triangles
  88. 880  IF Z$="a"THEN INPUT A:T2=A*PI/180:T1=PI/2-T2:IF A>=90 THEN 220
  89. 890  IF Z$="b"THEN INPUT B:T1=B*PI/180:T2=PI/2-T1:IF B>=90 THEN 220
  90. 900  IF Z$="c"THEN INPUT C
  91. 910  IF Z$="d"THEN INPUT D
  92. 920  IF Z$="e"THEN INPUT E
  93. 930  '
  94. 940  '.....oblique-angled triangles
  95. 950  IF Z$="f"THEN INPUT F:F=F*PI/180:IF F>=PI THEN 230
  96. 960  IF Z$="g"THEN INPUT G:G=G*PI/180:IF G>=PI THEN 230
  97. 970  IF Z$="h"THEN INPUT H:H=H*PI/180:IF H>=PI THEN 230
  98. 980  IF Z$="i"THEN INPUT I
  99. 990  IF Z$="j"THEN INPUT J
  100. 1000  IF Z$="k"THEN INPUT K
  101. 1010  '
  102. 1020  GOSUB 1040:GOTO 710
  103. 1030  '
  104. 1040  '.....solve right-angled triangle
  105. 1050  IF D*C THEN E=SQR(D^2+C^2):T1=ATN(D/C):T2=PI/2-T1:GOTO 1440
  106. 1060  IF D*E THEN C=SQR(E^2-D^2):X=D/E:GOSUB 360:T1=ASN:T2=PI/2-T1:GOTO 1440
  107. 1070  IF C*E THEN D=SQR(E^2-C^2):X=C/E:GOSUB 360:T1=ACS:T2=PI/2-T1:GOTO 1440
  108. 1080  IF C*T1 THEN D=C/TAN(T2):E=C/COS(T1):GOTO 1440
  109. 1090  IF D*T1 THEN C=D/TAN(T1):E=D/SIN(T1):GOTO 1440
  110. 1100  IF E*T1 THEN D=E*SIN(T1):C=E*COS(T1):GOTO 1440
  111. 1110  '
  112. 1120  '.....solve oblique angled triangle
  113. 1130  IF I*J*K THEN 1380                       '3 sides know
  114. 1140  '
  115. 1150  IF F=0 THEN IF G*H THEN F=PI-G-H         '3rd angle if two angles known
  116. 1160  IF G=0 THEN IF F*H THEN G=PI-F-H
  117. 1170  IF H=0 THEN IF F*G THEN H=PI-F-G
  118. 1180  '
  119. 1190  IF I*F*G*H THEN J=I*SIN(H)/SIN(G):K=I*SIN(F)/SIN(G):GOTO 1440
  120. 1200  IF J*F*G*H THEN K=J*SIN(F)/SIN(H):I=J*SIN(G)/SIN(H):GOTO 1440
  121. 1210  IF K*F*G*H THEN I=K*SIN(G)/SIN(F):J=K*SIN(H)/SIN(F):GOTO 1440
  122. 1220  IF F*G THEN IF F+G>=PI THEN 190
  123. 1230  IF G*H THEN IF G+H>=PI THEN 190
  124. 1240  IF H*F THEN IF H+F>=PI THEN 190
  125. 1250  '
  126. 1260  IF F=0 THEN IF J*K*H THEN X=K/J*SIN(H):GOSUB 360:F=ASN:GOTO 1150
  127. 1270  IF H=0 THEN IF J*K*F THEN X=J/K*SIN(F):GOSUB 360:H=ASN:GOTO 1150
  128. 1280  IF F=0 THEN IF I*K*G THEN X=K/I*SIN(G):GOSUB 360:F=ASN:GOTO 1150
  129. 1290  IF G=0 THEN IF I*K*F THEN X=I/K*SIN(F):GOSUB 360:G=ASN:GOTO 1150
  130. 1300  IF G=0 THEN IF I*J*H THEN X=I/J*SIN(H):GOSUB 360:G=ASN:GOTO 1150
  131. 1310  IF H=0 THEN IF I*J*G THEN X=J/I*SIN(G):GOSUB 360:H=ASN:GOTO 1150
  132. 1320  '
  133. 1330  IF I=0 THEN IF J*K*G THEN I=SQR(J^2+K^2-(2*J*K*COS(G))):GOTO 1380
  134. 1340  IF J=0 THEN IF I*K*H THEN J=SQR(I^2+K^2-(2*I*K*COS(H))):GOTO 1380
  135. 1350  IF K=0 THEN IF I*J*F THEN K=SQR(I^2+J^2-(2*I*J*COS(F))):GOTO 1380
  136. 1360  GOTO 1440
  137. 1370  '
  138. 1380  '.....3 sides known
  139. 1390  S=(I+J+K)/2
  140. 1400  IF F=0 THEN F=2*ATN(SQR((S-J)*(S-I)/(S*(S-K))))
  141. 1410  IF G=0 THEN G=2*ATN(SQR((S-J)*(S-K)/(S*(S-I))))
  142. 1420  IF H=0 THEN H=2*ATN(SQR((S-K)*(S-I)/(S*(S-J))))
  143. 1430  '
  144. 1440  COLOR 0,7
  145. 1450  '.....screen print
  146. 1460  IF T2 THEN COLOR 7,0:LOCATE 5,T+6:PRINT "  DEFSNGSOUNDSOUNDSOUND";
  147. 1470  IF T2 THEN COLOR 0,7:PRINT USING V$;T2*180/PI;:PRINT "<UNK! {00F8}>"
  148. 1480  IF T1 THEN COLOR 7,0:LOCATE 9,T+14:PRINT "  DEFSNGSOUNDSOUNDSOUND";
  149. 1490  IF T1 THEN COLOR 0,7:PRINT USING V$;T1*180/PI;:PRINT "<UNK! {00F8}>"
  150. 1500  IF C THEN LOCATE 11,T+9:PRINT USING U$;C;:PRINT " "
  151. 1510  IF D THEN LOCATE 9,T+1:PRINT USING U$;D;:PRINT " "
  152. 1520  IF E THEN LOCATE 7,T+10:PRINT USING U$;E;:PRINT " "
  153. 1530  IF F THEN COLOR 7,0:LOCATE 4,T+44:PRINT " DEFSNGSOUNDSOUNDSOUNDSOUND";
  154. 1540  IF F THEN COLOR 0,7:PRINT USING V$;F*180/PI;:PRINT "<UNK! {00F8}>"
  155. 1550  IF G THEN LOCATE 9,T+49:PRINT USING V$;G*180/PI;:PRINT "<UNK! {00F8}>"
  156. 1560  IF H THEN LOCATE 9,T+34:PRINT USING V$;H*180/PI;:PRINT "<UNK! {00F8}>"
  157. 1570  IF I THEN LOCATE 6,T+34:PRINT USING U$;I;:PRINT " "
  158. 1580  IF J THEN LOCATE 6,T+48:PRINT USING U$;J;:PRINT " "
  159. 1590  IF K THEN LOCATE 11,T+41:PRINT USING U$;K;:PRINT " "
  160. 1600  '
  161. 1610  COLOR 7,0
  162. 1620  IF T1*T2*C*D*E THEN 1660
  163. 1630  IF F*G*H*I*J*K THEN 1660
  164. 1640  RETURN
  165. 1650  '
  166. 1660  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  167. 1670  PRINT UL$;
  168. 1680  PRINT TAB(16);"NOTE: All calculated values have been rounded-off."
  169. 1690  PRINT UL$;
  170. 1700  LN=18:GOSUB 1730
  171. 1710  GOTO 80   'start
  172. 1720  '
  173. 1730  'HARDCOPY
  174. 1740  GOSUB 1850:LOCATE 25,2:COLOR 14,6
  175. 1750  PRINT " Press 1 to print screen, 2 to print screen & ";
  176. 1760  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  177. 1770  Z$=INKEY$:IF Z$="3"THEN GOSUB 1850:RETURN
  178. 1780  IF Z$="1"OR Z$="2"THEN GOSUB 1850:GOTO 1800
  179. 1790  GOTO 1770
  180. 1800  FOR QX=1 TO 24:FOR QY=1 TO 80
  181. 1810  LPRINT CHR$(SCREEN(QX,QY));
  182. 1820  NEXT QY:NEXT QX
  183. 1830  IF Z$="2"THEN LPRINT CHR$(12)
  184. 1840  GOTO 1740
  185. 1850  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  186.